home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / utils / exec33a.arj / EXTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-25  |  6KB  |  230 lines
  1. {
  2.    --- Version 3.3 91-11-25 14:02 ---
  3.  
  4.    EXTEST.PAS: EXEC function with memory swap - Test program.
  5.  
  6.    Public domain software by
  7.  
  8.         Thomas Wagner
  9.         Ferrari electronic GmbH
  10.         Beusselstrasse 27
  11.         D-1000 Berlin 21
  12.         Germany
  13. }
  14. program extest;
  15. uses
  16.    crt,
  17.    dos,
  18.    exec;
  19.  
  20. type
  21.    string4 = string [4];
  22.  
  23. {>e}
  24. {$DEFINE ENGLISH}
  25. {<}
  26.  
  27. function hexdig (d: integer): char;
  28.    begin
  29.    if d < 10
  30.       then hexdig := chr (d + ord('0'))
  31.       else hexdig := chr (d - 10 + ord ('A'));
  32.    end;
  33.  
  34. function hexstr (num: integer): string4;
  35.    var
  36.       i: integer;
  37.       s: string4;
  38.    begin
  39.    for i := 4 downto 1 do
  40.       begin
  41.       s [i] := hexdig (num mod 16);
  42.       num := num div 16;
  43.       end;
  44.    s [0] := chr(4);
  45.    hexstr := s;
  46.    end;
  47.  
  48.  
  49. {$IFDEF ENGLISH}
  50. procedure help;
  51.    begin
  52.    writeln ('Usage: EXTEST [options]');
  53.    writeln ('Options:');
  54.    writeln ('     -E    do not use EMS  for swapping');
  55.    writeln ('     -X    do not use XMS  for swapping');
  56.    writeln ('     -F    do not use File for swapping');
  57.    writeln ('     -T    Terminate after EXEC (no swap)');
  58.    writeln ('     -N    do Not swap');
  59.    writeln ('     -C    do not Copy environment');
  60.    writeln ('     -H    Hide swapfile');
  61.    writeln ('     -Z    Try XMS first, then EMS');
  62.    end;
  63. {$ELSE}
  64. procedure help;
  65.    begin;
  66.    writeln ('Benutzung: EXTEST [Optionen]');
  67.    writeln ('Optionen:');
  68.    writeln ('     -E    bei Auslagern kein EMS benutzen');
  69.    writeln ('     -X    bei Auslagern kein XMS benutzen');
  70.    writeln ('     -F    bei Auslagern keine Datei benutzen');
  71.    writeln ('     -T    Terminieren nach EXEC (keine Auslagerung)');
  72.    writeln ('     -N    Nicht Auslagern');
  73.    writeln ('     -C    Umgebungsvariablen nicht kopieren');
  74.    writeln ('     -H    Auslagerungsdatei "hidden"');
  75.    writeln ('     -Z    Zuerst XMS versuchen, dann EMS');
  76.    end;
  77. {$ENDIF}
  78.  
  79. {$F+}
  80. {$IFDEF ENGLISH}
  81. function spcheck (cmdbat: integer; swapping: integer; var execfn: string;
  82.                   var progpars: string): integer;
  83.    var
  84.      tmp: string [82];
  85.      l: integer;
  86.    begin
  87.    if swapping > 0
  88.       then begin
  89.       case swap_prep.swapmethod of
  90.          USE_EMS:
  91.                writeln ('Swapping to EMS handle ', swap_prep.handle);
  92.  
  93.          USE_XMS:
  94.                writeln ('Swapping to XMS handle ', swap_prep.handle);
  95.  
  96.          USE_FILE:
  97.                begin
  98.                l := 0;
  99.                while swap_prep.swapfilename [l] <> chr(0) do
  100.                   l := l + 1;
  101.                move (swap_prep.swapfilename, tmp [1], l);
  102.                tmp [0] := chr (l);
  103.                writeln ('Swapping to File <', tmp, '>');
  104.                end;
  105.          end;
  106.       end;
  107.    writeln ('Executing ', execfn, ' ', progpars);
  108.    writeln;
  109.    if (cmdbat = 3) and (pos ('/c', progpars) = 0)
  110.       then writeln ('Enter EXIT to return to EXTEST');
  111.  
  112.    spcheck := 0;
  113.    end;
  114. {$ELSE}
  115. function spcheck (cmdbat: integer; swapping: integer;
  116.                   var execfn: string; var progpars: string)
  117.                   : integer;
  118.    var
  119.      tmp: string [82];
  120.      l: integer;
  121.    begin
  122.    if swapping > 0
  123.       then begin
  124.       case swap_prep.swapmethod of
  125.          USE_EMS:
  126.                writeln ('Auslagerung auf EMS Handle ', swap_prep.handle);
  127.  
  128.          USE_XMS:
  129.                writeln ('Auslagerung auf XMS Handle ', swap_prep.handle);
  130.  
  131.          USE_FILE:
  132.                begin
  133.                l := 0;
  134.                while swap_prep.swapfilename [l] <> chr(0) do
  135.                   l := l + 1;
  136.                move (swap_prep.swapfilename, tmp [1], l);
  137.                tmp [0] := chr (l);
  138.                writeln ('Auslagerung auf Datei <', tmp, '>');
  139.                end;
  140.          end;
  141.       end;
  142.    writeln ('Ausführen ', execfn, ' ', progpars);
  143.    writeln;
  144.    if (cmdbat = 3) and (pos ('/c', progpars) = 0)
  145.       then writeln ('Geben Sie EXIT ein um zu EXTEST zurückzukehren');
  146.  
  147.    spcheck := 0;
  148.    end;
  149. {$ENDIF}
  150. {$F-}
  151.  
  152. var
  153.    method: integer;
  154.    needed: word;
  155.    env: boolean;
  156.    i, j: integer;
  157.    argv: string;
  158.    fn: string;
  159.    par: string;
  160.  
  161. begin
  162. @spawn_check := @spcheck;
  163.  
  164. method := USE_ALL;
  165. needed := $ffff;
  166. env := true;
  167.  
  168. for i := 1 to ParamCount do
  169.    begin
  170.    argv := ParamStr (i);
  171.    if (argv [1] <> '-') and (argv [1] <> '/')
  172.       then begin
  173.       help;
  174.       exit;
  175.       end;
  176.    for j := 2 to length (argv) do
  177.       case upcase (argv [j]) of
  178.          'E':   method := method and not USE_EMS;
  179.          'X':   method := method and not USE_XMS;
  180.          'F':   method := method and not USE_FILE;
  181.          'T':   method := 0;
  182.          'N':   needed := 0;
  183.          'C':   env := false;
  184.          'H':   method := method or HIDE_FILE;
  185.          'Z':   method := method or XMS_FIRST;
  186.          '-':   ;
  187.          '/':   ;
  188.          else   begin
  189.                 help;
  190.                 exit;
  191.                 end;
  192.          end;
  193.    end;
  194.  
  195. {$IFDEF ENGLISH}
  196. putenv ('XYZ=This is a test string for the spawned process');
  197. {$ELSE}
  198. putenv ('XYZ=Dies ist eine Umgebungsvariable für den aufgerufenen Prozeß');
  199. {$ENDIF}
  200.  
  201. repeat
  202. {$IFDEF ENGLISH}
  203.    writeln; write ('EXEC filename,params ("." to exit): ');
  204. {$ELSE}
  205.    writeln; write ('Dateiname,Parameter ("." beendet): ');
  206. {$ENDIF}
  207.    readln (fn);
  208.    writeln;
  209.    if fn = '.'
  210.       then exit;
  211.    i := pos (',', fn);
  212.    if i > 0
  213.       then begin
  214.       par := copy (fn, i + 1, length (fn) - i);
  215.       fn [0] := chr (i - 1);
  216.       end
  217.       else par := '';
  218.  
  219.    i := do_exec (fn, par, method, needed, env);
  220.  
  221. {$IFDEF ENGLISH}
  222.    writeln ('DO_EXEC returned ', hexstr (i));
  223. {$ELSE}
  224.    writeln ('DO_EXEC liefert ', hexstr (i));
  225. {$ENDIF}
  226. until false;
  227. end.
  228.  
  229. 
  230.